﻿unit WorkThreadPool;

interface

uses
  Winapi.Windows, System.Classes, System.SysUtils, IThread, FMX.Dialogs;

type
  TIWorkThreadPool = class;
  //虚拟线程池
  TOnCreateThreadEvent = function: TIThread of object;
  //线程池回调
  TOnCallBackEvent = procedure of object;
  PThreadParam = ^ThreadParam;
  ThreadParam  = packed record
    ThreadIndex:  Cardinal;                (* 索引        *)
    ThreadEvent:  Thandle;              (* 事件        *)
    ThreadObject: TIThread;            (* 指向线程    *)
  end;
  //工作线程
  TIWorkThread = class(TIThread)
  private
    WorkThreadPool: TIWorkThreadPool;
  protected
    procedure ThreadRoutine; override;
  public
    constructor Create(AWorkThreadPool: TIWorkThreadPool);
    destructor Destroy; override;
  end;
  TIWorkThreadPool = class
  private
    FOnCreateThread: TOnCreateThreadEvent;
    FActiveThreads: Integer;
    FStarted: Boolean;
    FOnCallBack: TOnCallBackEvent;
    FMaxThreads: Integer;
    FMinThreads: Integer;
    FThreadsList: TList;
    procedure SetActiveThreads(const Value: Integer);
    procedure SetMaxThreads(const Value: Integer);
    procedure SetMinThreads(const Value: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    function StartThreadPool: Boolean;
		procedure StopThreadPool;
  published
    property Started: Boolean read FStarted;
    property MinThreads: Integer read FMinThreads write SetMinThreads;
    property MaxThreads: Integer read FMaxThreads write SetMaxThreads;
    property ActiveThreads: Integer read FActiveThreads write SetActiveThreads;
    property OnCreateThread: TOnCreateThreadEvent read FOnCreateThread write FOnCreateThread;
    property OnCallBackEvent: TOnCallBackEvent read FOnCallBack write FOnCallBack;
  end;

implementation

{ TIWorkThreadPool }

constructor TIWorkThreadPool.Create;
begin
  inherited Create;
  FMaxThreads := 10;
  FMinThreads := 1;
  FActiveThreads := 4;
  FStarted := False;
  FThreadsList := TList.Create;
end;

destructor TIWorkThreadPool.Destroy;
begin
  if FStarted then StopThreadPool;
  FreeAndNil(FThreadsList);
  inherited Destroy;
end;

procedure TIWorkThreadPool.SetActiveThreads(const Value: Integer);
begin
  if (Value < FMinThreads) or (Value > FMaxThreads) then Exit;
  FActiveThreads := Value;
end;

procedure TIWorkThreadPool.SetMaxThreads(const Value: Integer);
begin
  if (Value < FMinThreads) or (Value < 0) then Exit;
  FMaxThreads := Value;
end;

procedure TIWorkThreadPool.SetMinThreads(const Value: Integer);
begin
  if (Value > FMaxThreads) or (Value < 0) then Exit;
  FMinThreads := Value;
end;

function TIWorkThreadPool.StartThreadPool: Boolean;
var
  i: Integer;
  FThread: TIThread;
  p_Threads: PThreadParam;
begin
  if (FStarted) then
  begin
    Result := False;
    Exit;
  end;
  for i := 1 to FActiveThreads do
  begin
    FThread := nil;
    if Assigned(FOnCreateThread) then FThread := FOnCreateThread;
    if not Assigned(FThread) then
      FThread := TIWorkThread.Create(Self);
    New(p_Threads);
    p_Threads^.ThreadIndex := i;
    p_Threads^.ThreadObject := FThread;
    p_Threads^.ThreadEvent := FThread.Handle;
    FThreadsList.Add(p_Threads);
    FThread.RunThread;
  end;
  FStarted := True;
  Result := True;
end;

procedure TIWorkThreadPool.StopThreadPool;
var
  i: Integer;
begin
  if (FStarted) then
  begin
    if FActiveThreads > 0 then
    begin
      for i := 1 to FActiveThreads do
        PThreadParam(FThreadsList.Items[i - 1]).ThreadObject.CloseThread;
      for i := 1 to FActiveThreads do
      begin
        WaitForSingleObject(PThreadParam(FThreadsList.Items[i - 1]).ThreadEvent, INFINITE);
        FreeAndNil(PThreadParam(FThreadsList.Items[i - 1])^.ThreadObject);
        Dispose(PThreadParam(FThreadsList.Items[i - 1]));
      end;
      FThreadsList.Clear;
    end;
    FStarted := False;
  end;
end;

{ TIWorkThread }

constructor TIWorkThread.Create(AWorkThreadPool: TIWorkThreadPool);
begin
  inherited Create;
  WorkThreadPool := AWorkThreadPool;
end;

destructor TIWorkThread.Destroy;
begin
  inherited Destroy;
end;

procedure TIWorkThread.ThreadRoutine;
begin
  if Assigned(WorkThreadPool.FOnCallBack) then
    WorkThreadPool.FOnCallBack;
end;

end.
